home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Precision Software Appli…tions Silver Collection 1
/
Precision Software Applications Silver Collection Volume One (PSM) (1993).iso
/
tutor
/
dbase1iv.exe
/
DB4LESS3.ZIP
/
EMP.LBG
< prev
next >
Wrap
Text File
|
1988-11-17
|
5KB
|
237 lines
* Program............: D:\DBSYS\CLASSES\BT4W\EMP.LBG
* Date...............: 11-17-88
* Version............: dBASE IV, Label 1
*
* Label Specifics:
* Wide - 35
* Tall - 5
* Indentation - 0
* Number across - 2
* Space between - 2
* Lines between - 1
* Blankable lines - 1
* Print formatted - 3
*
PARAMETER ll_sample
*-- Set printer variables for this procedure only
PRIVATE _peject, _ploffset, _wrap
*-- Test for End of file
IF EOF()
RETURN
ENDIF
IF SET("TALK")="ON"
SET TALK OFF
gc_talk="ON"
ELSE
gc_talk="OFF"
ENDIF
gc_space = SET("SPACE")
SET SPACE OFF
gc_time=TIME() && system time for predefined field
gd_date=DATE() && system date " " " "
gl_fandl=.F. && first and last record flag
gl_prntflg=.T. && Continue printing flag
gn_column=1
gn_element=0
gn_line=1
gn_memowid=SET("MEMOWIDTH")
SET MEMOWIDTH TO 254
gn_page=_pageno && capture page number for multiple copies
_plineno=0
_wrap = .F.
IF ll_sample
DO Sample
IF LASTKEY() = 27
RETURN
ENDIF
ENDIF
*-- Setup Environment
ON ESCAPE DO prnabort
*-- Initialize array(s) for 2 across labels
DECLARE isfound[1]
DECLARE tmp4lbl[1,6]
DECLARE gn_line2[2]
PRINTJOB
*-- set page number for multiple copies
_pageno=gn_page
DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
STORE .F. TO isfound[1]
tmp4lbl[1,1]=FNAME
tmp4lbl[1,2]=LNAME
tmp4lbl[1,3]=ADDRESS
tmp4lbl[1,4]=CITY
tmp4lbl[1,5]=STATE
tmp4lbl[1,6]=ZIP
CONTINUE
IF FOUND() .AND. .NOT. EOF()
isfound[1]=.T.
ENDIF
gn_line=2
*-- Column 1
?? tmp4lbl[1,1] PICTURE "@T XXXXXXXXXXXXXX" AT 0 ;
," " ;
,tmp4lbl[1,2] PICTURE "@T XXXXXXXXXXXXXXXXXX" ,
*-- Column 2
IF isfound[1]
?? FNAME PICTURE "@T XXXXXXXXXXXXXX" AT 37 ;
," " ;
,LNAME PICTURE "@T XXXXXXXXXXXXXXXXXX"
ENDIF
?
*-- Check for blank lines
DO chk4null WITH 1, 1, 2
*-- Column 1
?? tmp4lbl[1,4] PICTURE "@T" AT 0 ;
,", " ;
,tmp4lbl[1,5] PICTURE "@T" ;
," " ;
,tmp4lbl[1,6] PICTURE "@T XXXXX" ,
*-- Column 2
IF isfound[1]
?? CITY PICTURE "@T" AT 37 ;
,", " ;
,STATE PICTURE "@T" ;
," " ;
,ZIP PICTURE "@T XXXXX"
ENDIF
?
DO WHILE gn_line < 6
?
gn_line=gn_line+1
ENDDO
CONTINUE
ENDDO
IF .NOT. gl_prntflg
SET MEMOWIDTH TO gn_memowid
SET SPACE &gc_space.
SET TALK &gc_talk.
ON ESCAPE
RETURN
ENDIF
ENDPRINTJOB
SET MEMOWIDTH TO gn_memowid
SET SPACE &gc_space.
SET TALK &gc_talk.
ON ESCAPE
RETURN
* EOP: D:\DBSYS\CLASSES\BT4W\EMP.LBG
PROCEDURE prnabort
gl_prntflg=.F.
RETURN
* EOP: prnabort
*
*-- The next 2 function file are for blank line checking
FUNCTION ___11
lc_ret=.F.
*-- Test for blank line
IF LEN(TRIM( tmp4lbl[1,3] )) > 0
ll_output=.T.
?? tmp4lbl[1,3] PICTURE "@T" AT 0 ,
ENDIF
RETURN lc_ret
FUNCTION ___12
lc_ret=.F.
*-- Column 2
IF isfound[1]
*-- Test for blank line
IF LEN(TRIM( ADDRESS )) > 0
ll_output=.T.
?? ADDRESS PICTURE "@T" AT 37
ENDIF
ENDIF
RETURN lc_ret
PROCEDURE chk4null
*-- Parameters:
*
*-- 1) line number on the design surface
*-- 2) maximum number of printable lines
*-- 3) parameter 2 times number of labels across
*
PARAMETERS ln_line, ln_nolines, ln_element
gn_element=0
gn_line2[1]=ln_line
gn_line2[2]=ln_line
lc_temp=SPACE(7)
ll_output=.F.
DO WHILE gn_element < ln_element
gn_column=1
ll_output=.F.
DO WHILE gn_column <= 2
IF gn_line2[gn_column] < ln_line+ln_nolines
lc_temp=LTRIM(STR(gn_line2[gn_column]))+LTRIM(STR(gn_column))
DO WHILE ___&lc_temp.()
gn_element=gn_element+1
gn_line2[gn_column]=gn_line2[gn_column]+1
lc_temp=LTRIM(STR(gn_line2[gn_column]))+LTRIM(STR(gn_column))
ENDDO
gn_element=gn_element+1
gn_line2[gn_column]=gn_line2[gn_column]+1
ENDIF
gn_column=gn_column+1
ENDDO
IF ll_output
?
gn_line=gn_line+1
ENDIF
ENDDO
RETURN
* EOP: chk4null
PROCEDURE SAMPLE
PRIVATE x,y,choice
DEFINE WINDOW w4sample FROM 15,20 TO 17,60 DOUBLE
choice="Y"
x=0
DO WHILE choice = "Y"
y=0
?
DO WHILE y < 5
x=0
DO WHILE x < 2
?? REPLICATE("X",35)+SPACE(2)
x=x+1
ENDDO
?
y=y+1
ENDDO
x=0
DO WHILE x < 1
?
x=x+1
ENDDO
ACTIVATE WINDOW w4sample
@ 0,3 SAY "Do you want more samples? (Y/N)";
GET choice PICTURE "!" VALID choice $ "NY"
READ
DEACTIVATE WINDOW w4sample
IF LASTKEY() = 27
EXIT
ENDIF
ENDDO
RELEASE WINDOW w4sample
RETURN
* EOP: SAMPLE